{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards   #-}

-- | Accessors to GHC RTS flags.
-- Descriptions of flags can be seen in
-- <https://www.haskell.org/ghc/docs/latest/html/users_guide/runtime-control.html GHC User's Guide>,
-- or by running RTS help message using @+RTS --help@.
--
-- @since 4.8.0.0
--
-- TODO: Implement this
module GHC.RTS.Flags
  ( --RtsTime
  -- , RtsNat
  -- , RTSFlags (..)
  -- , GiveGCStats (..)
  -- , GCFlags (..)
  -- , ConcFlags (..)
  -- , MiscFlags (..)
  -- , DebugFlags (..)
  -- , DoCostCentres (..)
  -- , CCFlags (..)
  -- , DoHeapProfile (..)
  -- , ProfFlags (..)
  -- , DoTrace (..)
  -- , TraceFlags (..)
  -- , TickyFlags (..)
  -- , getRTSFlags
  -- , getGCFlags
  -- , getConcFlags
  -- , getMiscFlags
  -- , getDebugFlags
  -- , getCCFlags
  -- , getProfFlags
  -- , getTraceFlags
  -- , getTickyFlags
  ) where

-- #include "Rts.h"
-- #include "rts/Flags.h"

-- import Control.Applicative
-- import Control.Monad

-- import Foreign.C.String    (peekCString)
-- import Foreign.C.Types     (CChar, CInt)
-- import Foreign.Ptr         (Ptr, nullPtr)
-- import Foreign.Storable    (peekByteOff)

-- import GHC.Base
-- import GHC.Enum
-- import GHC.IO
-- import GHC.Real
-- import GHC.Show
-- import GHC.Word

-- -- | @'Time'@ is defined as a @'StgWord64'@ in @stg/Types.h@
-- --
-- -- @since 4.8.2.0
-- type RtsTime = Word64

-- -- | @'nat'@ defined in @rts/Types.h@
-- --
-- -- @since 4.8.2.0
-- type RtsNat = #{type unsigned int}

-- -- | Should we produce a summary of the garbage collector statistics after the
-- -- program has exited?
-- --
-- -- @since 4.8.2.0
-- data GiveGCStats
--     = NoGCStats
--     | CollectGCStats
--     | OneLineGCStats
--     | SummaryGCStats
--     | VerboseGCStats
--     deriving (Show)

-- instance Enum GiveGCStats where
--     fromEnum NoGCStats      = #{const NO_GC_STATS}
--     fromEnum CollectGCStats = #{const COLLECT_GC_STATS}
--     fromEnum OneLineGCStats = #{const ONELINE_GC_STATS}
--     fromEnum SummaryGCStats = #{const SUMMARY_GC_STATS}
--     fromEnum VerboseGCStats = #{const VERBOSE_GC_STATS}

--     toEnum #{const NO_GC_STATS}      = NoGCStats
--     toEnum #{const COLLECT_GC_STATS} = CollectGCStats
--     toEnum #{const ONELINE_GC_STATS} = OneLineGCStats
--     toEnum #{const SUMMARY_GC_STATS} = SummaryGCStats
--     toEnum #{const VERBOSE_GC_STATS} = VerboseGCStats
--     toEnum e = error ("invalid enum for GiveGCStats: " ++ show e)

-- -- | Parameters of the garbage collector.
-- --
-- -- @since 4.8.0.0
-- data GCFlags = GCFlags
--     { statsFile             :: Maybe FilePath
--     , giveStats             :: GiveGCStats
--     , maxStkSize            :: RtsNat
--     , initialStkSize        :: RtsNat
--     , stkChunkSize          :: RtsNat
--     , stkChunkBufferSize    :: RtsNat
--     , maxHeapSize           :: RtsNat
--     , minAllocAreaSize      :: RtsNat
--     , minOldGenSize         :: RtsNat
--     , heapSizeSuggestion    :: RtsNat
--     , heapSizeSuggestionAuto :: Bool
--     , oldGenFactor          :: Double
--     , pcFreeHeap            :: Double
--     , generations           :: RtsNat
--     , steps                 :: RtsNat
--     , squeezeUpdFrames      :: Bool
--     , compact               :: Bool -- ^ True <=> "compact all the time"
--     , compactThreshold      :: Double
--     , sweep                 :: Bool
--       -- ^ use "mostly mark-sweep" instead of copying for the oldest generation
--     , ringBell              :: Bool
--     , frontpanel            :: Bool
--     , idleGCDelayTime       :: RtsTime
--     , doIdleGC              :: Bool
--     , heapBase              :: Word -- ^ address to ask the OS for memory
--     , allocLimitGrace       :: Word
--     } deriving (Show)

-- -- | Parameters concerning context switching
-- --
-- -- @since 4.8.0.0
-- data ConcFlags = ConcFlags
--     { ctxtSwitchTime  :: RtsTime
--     , ctxtSwitchTicks :: Int
--     } deriving (Show)

-- -- | Miscellaneous parameters
-- --
-- -- @since 4.8.0.0
-- data MiscFlags = MiscFlags
--     { tickInterval          :: RtsTime
--     , installSignalHandlers :: Bool
--     , machineReadable       :: Bool
--     , linkerMemBase         :: Word
--       -- ^ address to ask the OS for memory for the linker, 0 ==> off
--     } deriving (Show)

-- -- | Flags to control debugging output & extra checking in various
-- -- subsystems.
-- --
-- -- @since 4.8.0.0
-- data DebugFlags = DebugFlags
--     { scheduler   :: Bool -- ^ 's'
--     , interpreter :: Bool -- ^ 'i'
--     , weak        :: Bool -- ^ 'w'
--     , gccafs      :: Bool -- ^ 'G'
--     , gc          :: Bool -- ^ 'g'
--     , block_alloc :: Bool -- ^ 'b'
--     , sanity      :: Bool -- ^ 'S'
--     , stable      :: Bool -- ^ 't'
--     , prof        :: Bool -- ^ 'p'
--     , linker      :: Bool -- ^ 'l' the object linker
--     , apply       :: Bool -- ^ 'a'
--     , stm         :: Bool -- ^ 'm'
--     , squeeze     :: Bool -- ^ 'z' stack squeezing & lazy blackholing
--     , hpc         :: Bool -- ^ 'c' coverage
--     , sparks      :: Bool -- ^ 'r'
--     } deriving (Show)

-- -- | Should the RTS produce a cost-center summary?
-- --
-- -- @since 4.8.2.0
-- data DoCostCentres
--     = CostCentresNone
--     | CostCentresSummary
--     | CostCentresVerbose
--     | CostCentresAll
--     | CostCentresXML
--     deriving (Show)

-- instance Enum DoCostCentres where
--     fromEnum CostCentresNone    = #{const COST_CENTRES_NONE}
--     fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY}
--     fromEnum CostCentresVerbose = #{const COST_CENTRES_VERBOSE}
--     fromEnum CostCentresAll     = #{const COST_CENTRES_ALL}
--     fromEnum CostCentresXML     = #{const COST_CENTRES_XML}

--     toEnum #{const COST_CENTRES_NONE}    = CostCentresNone
--     toEnum #{const COST_CENTRES_SUMMARY} = CostCentresSummary
--     toEnum #{const COST_CENTRES_VERBOSE} = CostCentresVerbose
--     toEnum #{const COST_CENTRES_ALL}     = CostCentresAll
--     toEnum #{const COST_CENTRES_XML}     = CostCentresXML
--     toEnum e = error ("invalid enum for DoCostCentres: " ++ show e)

-- -- | Parameters pertaining to the cost-center profiler.
-- --
-- -- @since 4.8.0.0
-- data CCFlags = CCFlags
--     { doCostCentres :: DoCostCentres
--     , profilerTicks :: Int
--     , msecsPerTick  :: Int
--     } deriving (Show)

-- -- | What sort of heap profile are we collecting?
-- --
-- -- @since 4.8.2.0
-- data DoHeapProfile
--     = NoHeapProfiling
--     | HeapByCCS
--     | HeapByMod
--     | HeapByDescr
--     | HeapByType
--     | HeapByRetainer
--     | HeapByLDV
--     | HeapByClosureType
--     deriving (Show)

-- instance Enum DoHeapProfile where
--     fromEnum NoHeapProfiling   = #{const NO_HEAP_PROFILING}
--     fromEnum HeapByCCS         = #{const HEAP_BY_CCS}
--     fromEnum HeapByMod         = #{const HEAP_BY_MOD}
--     fromEnum HeapByDescr       = #{const HEAP_BY_DESCR}
--     fromEnum HeapByType        = #{const HEAP_BY_TYPE}
--     fromEnum HeapByRetainer    = #{const HEAP_BY_RETAINER}
--     fromEnum HeapByLDV         = #{const HEAP_BY_LDV}
--     fromEnum HeapByClosureType = #{const HEAP_BY_CLOSURE_TYPE}

--     toEnum #{const NO_HEAP_PROFILING}    = NoHeapProfiling
--     toEnum #{const HEAP_BY_CCS}          = HeapByCCS
--     toEnum #{const HEAP_BY_MOD}          = HeapByMod
--     toEnum #{const HEAP_BY_DESCR}        = HeapByDescr
--     toEnum #{const HEAP_BY_TYPE}         = HeapByType
--     toEnum #{const HEAP_BY_RETAINER}     = HeapByRetainer
--     toEnum #{const HEAP_BY_LDV}          = HeapByLDV
--     toEnum #{const HEAP_BY_CLOSURE_TYPE} = HeapByClosureType
--     toEnum e = error ("invalid enum for DoHeapProfile: " ++ show e)

-- -- | Parameters of the cost-center profiler
-- --
-- -- @since 4.8.0.0
-- data ProfFlags = ProfFlags
--     { doHeapProfile            :: DoHeapProfile
--     , heapProfileInterval      :: RtsTime -- ^ time between samples
--     , heapProfileIntervalTicks :: Word    -- ^ ticks between samples (derived)
--     , includeTSOs              :: Bool
--     , showCCSOnException       :: Bool
--     , maxRetainerSetSize       :: Word
--     , ccsLength                :: Word
--     , modSelector              :: Maybe String
--     , descrSelector            :: Maybe String
--     , typeSelector             :: Maybe String
--     , ccSelector               :: Maybe String
--     , ccsSelector              :: Maybe String
--     , retainerSelector         :: Maybe String
--     , bioSelector              :: Maybe String
--     } deriving (Show)

-- -- | Is event tracing enabled?
-- --
-- -- @since 4.8.2.0
-- data DoTrace
--     = TraceNone      -- ^ no tracing
--     | TraceEventLog  -- ^ send tracing events to the event log
--     | TraceStderr    -- ^ send tracing events to @stderr@
--     deriving (Show)

-- instance Enum DoTrace where
--     fromEnum TraceNone     = #{const TRACE_NONE}
--     fromEnum TraceEventLog = #{const TRACE_EVENTLOG}
--     fromEnum TraceStderr   = #{const TRACE_STDERR}

--     toEnum #{const TRACE_NONE}     = TraceNone
--     toEnum #{const TRACE_EVENTLOG} = TraceEventLog
--     toEnum #{const TRACE_STDERR}   = TraceStderr
--     toEnum e = error ("invalid enum for DoTrace: " ++ show e)

-- -- | Parameters pertaining to event tracing
-- --
-- -- @since 4.8.0.0
-- data TraceFlags = TraceFlags
--     { tracing        :: DoTrace
--     , timestamp      :: Bool -- ^ show timestamp in stderr output
--     , traceScheduler :: Bool -- ^ trace scheduler events
--     , traceGc        :: Bool -- ^ trace GC events
--     , sparksSampled  :: Bool -- ^ trace spark events by a sampled method
--     , sparksFull     :: Bool -- ^ trace spark events 100% accurately
--     , user           :: Bool -- ^ trace user events (emitted from Haskell code)
--     } deriving (Show)

-- -- | Parameters pertaining to ticky-ticky profiler
-- --
-- -- @since 4.8.0.0
-- data TickyFlags = TickyFlags
--     { showTickyStats :: Bool
--     , tickyFile      :: Maybe FilePath
--     } deriving (Show)

-- -- | Parameters of the runtime system
-- --
-- -- @since 4.8.0.0
-- data RTSFlags = RTSFlags
--     { gcFlags         :: GCFlags
--     , concurrentFlags :: ConcFlags
--     , miscFlags       :: MiscFlags
--     , debugFlags      :: DebugFlags
--     , costCentreFlags :: CCFlags
--     , profilingFlags  :: ProfFlags
--     , traceFlags      :: TraceFlags
--     , tickyFlags      :: TickyFlags
--     } deriving (Show)

-- foreign import ccall safe "getGcFlags"
--   getGcFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getConcFlags"
--   getConcFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getMiscFlags"
--   getMiscFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getDebugFlags"
--   getDebugFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getCcFlags"
--   getCcFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getProfFlags" getProfFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getTraceFlags"
--   getTraceFlagsPtr :: IO (Ptr ())

-- foreign import ccall safe "getTickyFlags"
--   getTickyFlagsPtr :: IO (Ptr ())

-- getRTSFlags :: IO RTSFlags
-- getRTSFlags = do
--   RTSFlags <$> getGCFlags
--            <*> getConcFlags
--            <*> getMiscFlags
--            <*> getDebugFlags
--            <*> getCCFlags
--            <*> getProfFlags
--            <*> getTraceFlags
--            <*> getTickyFlags

-- peekFilePath :: Ptr () -> IO (Maybe FilePath)
-- peekFilePath ptr
--   | ptr == nullPtr = return Nothing
--   | otherwise      = return (Just "<filepath>")

-- -- | Read a NUL terminated string. Return Nothing in case of a NULL pointer.
-- peekCStringOpt :: Ptr CChar -> IO (Maybe String)
-- peekCStringOpt ptr
--   | ptr == nullPtr = return Nothing
--   | otherwise      = Just <$> peekCString ptr

-- getGCFlags :: IO GCFlags
-- getGCFlags = do
--   ptr <- getGcFlagsPtr
--   GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
--           <*> (toEnum . fromIntegral <$>
--                 (#{peek GC_FLAGS, giveStats} ptr :: IO RtsNat))
--           <*> #{peek GC_FLAGS, maxStkSize} ptr
--           <*> #{peek GC_FLAGS, initialStkSize} ptr
--           <*> #{peek GC_FLAGS, stkChunkSize} ptr
--           <*> #{peek GC_FLAGS, stkChunkBufferSize} ptr
--           <*> #{peek GC_FLAGS, maxHeapSize} ptr
--           <*> #{peek GC_FLAGS, minAllocAreaSize} ptr
--           <*> #{peek GC_FLAGS, minOldGenSize} ptr
--           <*> #{peek GC_FLAGS, heapSizeSuggestion} ptr
--           <*> #{peek GC_FLAGS, heapSizeSuggestionAuto} ptr
--           <*> #{peek GC_FLAGS, oldGenFactor} ptr
--           <*> #{peek GC_FLAGS, pcFreeHeap} ptr
--           <*> #{peek GC_FLAGS, generations} ptr
--           <*> #{peek GC_FLAGS, steps} ptr
--           <*> #{peek GC_FLAGS, squeezeUpdFrames} ptr
--           <*> #{peek GC_FLAGS, compact} ptr
--           <*> #{peek GC_FLAGS, compactThreshold} ptr
--           <*> #{peek GC_FLAGS, sweep} ptr
--           <*> #{peek GC_FLAGS, ringBell} ptr
--           <*> #{peek GC_FLAGS, frontpanel} ptr
--           <*> #{peek GC_FLAGS, idleGCDelayTime} ptr
--           <*> #{peek GC_FLAGS, doIdleGC} ptr
--           <*> #{peek GC_FLAGS, heapBase} ptr
--           <*> #{peek GC_FLAGS, allocLimitGrace} ptr

-- getConcFlags :: IO ConcFlags
-- getConcFlags = do
--   ptr <- getConcFlagsPtr
--   ConcFlags <$> #{peek CONCURRENT_FLAGS, ctxtSwitchTime} ptr
--             <*> #{peek CONCURRENT_FLAGS, ctxtSwitchTicks} ptr

-- getMiscFlags :: IO MiscFlags
-- getMiscFlags = do
--   ptr <- getMiscFlagsPtr
--   MiscFlags <$> #{peek MISC_FLAGS, tickInterval} ptr
--             <*> #{peek MISC_FLAGS, install_signal_handlers} ptr
--             <*> #{peek MISC_FLAGS, machineReadable} ptr
--             <*> #{peek MISC_FLAGS, linkerMemBase} ptr

-- getDebugFlags :: IO DebugFlags
-- getDebugFlags = do
--   ptr <- getDebugFlagsPtr
--   DebugFlags <$> #{peek DEBUG_FLAGS, scheduler} ptr
--              <*> #{peek DEBUG_FLAGS, interpreter} ptr
--              <*> #{peek DEBUG_FLAGS, weak} ptr
--              <*> #{peek DEBUG_FLAGS, gccafs} ptr
--              <*> #{peek DEBUG_FLAGS, gc} ptr
--              <*> #{peek DEBUG_FLAGS, block_alloc} ptr
--              <*> #{peek DEBUG_FLAGS, sanity} ptr
--              <*> #{peek DEBUG_FLAGS, stable} ptr
--              <*> #{peek DEBUG_FLAGS, prof} ptr
--              <*> #{peek DEBUG_FLAGS, linker} ptr
--              <*> #{peek DEBUG_FLAGS, apply} ptr
--              <*> #{peek DEBUG_FLAGS, stm} ptr
--              <*> #{peek DEBUG_FLAGS, squeeze} ptr
--              <*> #{peek DEBUG_FLAGS, hpc} ptr
--              <*> #{peek DEBUG_FLAGS, sparks} ptr

-- getCCFlags :: IO CCFlags
-- getCCFlags = do
--   ptr <- getCcFlagsPtr
--   CCFlags <$> (toEnum . fromIntegral
--                 <$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO RtsNat))
--           <*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
--           <*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr

-- getProfFlags :: IO ProfFlags
-- getProfFlags = do
--   ptr <- getProfFlagsPtr
--   ProfFlags <$> (toEnum <$> #{peek PROFILING_FLAGS, doHeapProfile} ptr)
--             <*> #{peek PROFILING_FLAGS, heapProfileInterval} ptr
--             <*> #{peek PROFILING_FLAGS, heapProfileIntervalTicks} ptr
--             <*> #{peek PROFILING_FLAGS, includeTSOs} ptr
--             <*> #{peek PROFILING_FLAGS, showCCSOnException} ptr
--             <*> #{peek PROFILING_FLAGS, maxRetainerSetSize} ptr
--             <*> #{peek PROFILING_FLAGS, ccsLength} ptr
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, modSelector} ptr)
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, descrSelector} ptr)
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, typeSelector} ptr)
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccSelector} ptr)
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, ccsSelector} ptr)
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, retainerSelector} ptr)
--             <*> (peekCStringOpt =<< #{peek PROFILING_FLAGS, bioSelector} ptr)

-- getTraceFlags :: IO TraceFlags
-- getTraceFlags = do
--   ptr <- getTraceFlagsPtr
--   TraceFlags <$> (toEnum . fromIntegral
--                    <$> (#{peek TRACE_FLAGS, tracing} ptr :: IO CInt))
--              <*> #{peek TRACE_FLAGS, timestamp} ptr
--              <*> #{peek TRACE_FLAGS, scheduler} ptr
--              <*> #{peek TRACE_FLAGS, gc} ptr
--              <*> #{peek TRACE_FLAGS, sparks_sampled} ptr
--              <*> #{peek TRACE_FLAGS, sparks_full} ptr
--              <*> #{peek TRACE_FLAGS, user} ptr

-- getTickyFlags :: IO TickyFlags
-- getTickyFlags = do
--   ptr <- getTickyFlagsPtr
--   TickyFlags <$> #{peek TICKY_FLAGS, showTickyStats} ptr
--              <*> (peekFilePath =<< #{peek TICKY_FLAGS, tickyFile} ptr)
